subroutine effectt2_s(t2, t1, icore, fact)
!use common 
use mod_symm
use mod_iop
use mod_size
use mod_orbit
use mod_ioff 
implicit none
real*8, intent(inout) :: fact
real*4, intent(inout) :: icore(*)
real*4, intent(inout) :: t2(*), t1(*)
!
integer i, j, a, b, irrepi, irrepj, irrepa, irrepb
integer irrepai, irrepbj, irrepaj, irrepbi
integer idxai, idxbj, idxaj, idxbi 
integer iai, ibj, iaj, ibi
integer numa, numb, numi, numj, iofft2(8) 
integer irrepab, irrepij, numab, numij, na
integer ioffoa(8), ioffva(8) 
integer ioffob(8), ioffvb(8) 
integer idxa, idxb, idxi, idxj, idx, iofft, nsize 
integer zorb2(8)
integer, external :: irpdso, isymoffso, idsymsoc
real*8 dtmp
!
zorb2(1:8) = 1
nsize = idsymsoc(1, vrta, popa, 1, zorb2, zorb2, 1)
nsize = max(nsize, idsymsoc(1, vrtb, popb, 1, zorb2, zorb2, 1)) 
!
!---------------for AAAA 
call zeroso(icore, nsize*2)
call myicopyso(t1, icore, ifvo(2)-ifvo(1))
iofft2(1) = 1
do irrepij = 1, nirrep - 1
   irrepab = dirprd(irrepij, 1) 
   numij = irpdso(irrepij, popa, popa, 0) 
   numab = irpdso(irrepab, vrta, vrta, 0) 
   iofft2(irrepij+1) = iofft2(irrepij) + numab*numij
enddo 
!
do irrepij = 1, nirrep 
   irrepab = dirprd(irrepij, 1) 
   numab = irpdso(irrepab, vrta, vrta, 0)
   numij = irpdso(irrepij, popa, popa, 0)
   do irrepj = 1, nirrep 
      irrepi = dirprd(irrepij, irrepj) 
      numi = popa(irrepi)
      numj = popa(irrepj)
      if(irrepi>irrepj) cycle
      do irrepb = 1, nirrep
         irrepa = dirprd(irrepb, irrepab)
         if(irrepa>irrepb) cycle
         numa = vrta(irrepa) 
         numb = vrta(irrepb)
         iofft = iofft2(irrepij)-1 &
              + (isymoffso(irrepj,irrepij,popa,popa,0)-1)*numab & 
              +  isymoffso(irrepb,irrepab,vrta,vrta,0)-1
         irrepai = dirprd(irrepa, irrepi) 
         irrepbj = dirprd(irrepb, irrepj) 
         irrepaj = dirprd(irrepa, irrepj) 
         irrepbi = dirprd(irrepb, irrepi) 
         iai = isymoffso(irrepi, irrepai, vrta, popa, 1) 
         ibj = isymoffso(irrepj, irrepbj, vrta, popa, 1) 
         iaj = isymoffso(irrepj, irrepaj, vrta, popa, 1) 
         ibi = isymoffso(irrepi, irrepbi, vrta, popa, 1)
         if(irrepai/=1) iai = iai + ifvo(2)-ifvo(1)
         if(irrepbi/=1) ibi = ibi + ifvo(2)-ifvo(1)
         if(irrepaj/=1) iaj = iaj + ifvo(2)-ifvo(1)
         if(irrepbj/=1) ibj = ibj + ifvo(2)-ifvo(1)
         if(irrepj/=irrepi.and.irrepa/=irrepb) then 
!$omp parallel do
            do j = 1, numj
            do i = 1, numi 
            do b = 1, numb
            do a = 1, numa 
               idx = iofft + ((j-1)*numi + i-1)*numab &
                          +  (b-1)*numa + a
               idxai = iai-1 + (i-1)*numa+a 
               idxbj = ibj-1 + (j-1)*numb+b
               idxaj = iaj-1 + (j-1)*numa+a
               idxbi = ibi-1 + (i-1)*numb+b
               t2(idx) = t2(idx) + &
                     fact*(icore(idxai)*icore(idxbj)-icore(idxbi)*icore(idxaj))
            enddo
            enddo
            enddo
            enddo 
!$omp end parallel do
         elseif(irrepj==irrepi.and.irrepa/=irrepb) then
!$omp parallel do
            do j = 2, numj
            do i = 1, j-1 
            do b = 1, numb
            do a = 1, numa
               idx = iofft + ((j-1)*(j-2)/2 + i-1)*numab &
                          +  (b-1)*numa + a
               idxai = iai-1 + (i-1)*numa+a 
               idxbj = ibj-1 + (j-1)*numb+b
               idxaj = iaj-1 + (j-1)*numa+a
               idxbi = ibi-1 + (i-1)*numb+b
               t2(idx) = t2(idx) + &
                     fact*(icore(idxai)*icore(idxbj)-icore(idxbi)*icore(idxaj))
            enddo
            enddo
            enddo
            enddo
!$omp end parallel do
         elseif(irrepj/=irrepi.and.irrepa==irrepb) then
!$omp parallel do
            do j = 1, numj
            do i = 1, numi
            do b = 2, numb
            do a = 1, b-1
               idx = iofft + ((j-1)*numi + i-1)*numab &
                          +  (b-1)*(b-2)/2 + a
               idxai = iai-1 + (i-1)*numa+a 
               idxbj = ibj-1 + (j-1)*numb+b
               idxaj = iaj-1 + (j-1)*numa+a
               idxbi = ibi-1 + (i-1)*numb+b
               t2(idx) = t2(idx) + &
                     fact*(icore(idxai)*icore(idxbj)-icore(idxbi)*icore(idxaj))
            enddo
            enddo
            enddo
            enddo
!$omp end parallel do
         elseif(irrepj==irrepi.and.irrepa==irrepb) then
!$omp parallel do
            do j = 2, numj
            do i = 1, j-1
            do b = 2, numb
            do a = 1, b-1
               idx = iofft + ((j-1)*(j-2)/2 + i-1)*numab &
                          +  (b-1)*(b-2)/2 + a
               idxai = iai-1 + (i-1)*numa+a 
               idxbj = ibj-1 + (j-1)*numb+b
               idxaj = iaj-1 + (j-1)*numa+a
               idxbi = ibi-1 + (i-1)*numb+b
               t2(idx) = t2(idx) + &
                     fact*(icore(idxai)*icore(idxbj)-icore(idxbi)*icore(idxaj))
            enddo
            enddo
            enddo
            enddo
!$omp end parallel do
         endif
      enddo
   enddo       
enddo
!
!---------------for BBBB 
call zeroso(icore, nsize*2)
call myicopyso(t1(ifvo(2)), icore, ifvo(3)-ifvo(2))
!
iofft2(1) = 1
do irrepij = 1, nirrep - 1
   irrepab = dirprd(irrepij, 1)
   numij = irpdso(irrepij, popb, popb, 0)
   numab = irpdso(irrepab, vrtb, vrtb, 0)
   iofft2(irrepij+1) = iofft2(irrepij) + numab*numij
enddo
!
do irrepij = 1, nirrep
   irrepab = dirprd(irrepij, 1)
   numab = irpdso(irrepab, vrtb, vrtb, 0)
   numij = irpdso(irrepij, popb, popb, 0)
   do irrepj = 1, nirrep
      irrepi = dirprd(irrepij, irrepj)
      numi = popb(irrepi)
      numj = popb(irrepj)
      if(irrepi>irrepj) cycle
      do irrepb = 1, nirrep
         irrepa = dirprd(irrepb, irrepab)
         if(irrepa>irrepb) cycle
         numa = vrtb(irrepa)
         numb = vrtb(irrepb)
         iofft = ioi3(3) - 1 + iofft2(irrepij)-1 &
              + (isymoffso(irrepj,irrepij,popb,popb,0)-1)*numab &
              +  isymoffso(irrepb,irrepab,vrtb,vrtb,0)-1
         irrepai = dirprd(irrepa, irrepi) 
         irrepbj = dirprd(irrepb, irrepj) 
         irrepaj = dirprd(irrepa, irrepj) 
         irrepbi = dirprd(irrepb, irrepi) 
         iai = isymoffso(irrepi, irrepai, vrtb, popb, 1) 
         ibj = isymoffso(irrepj, irrepbj, vrtb, popb, 1) 
         iaj = isymoffso(irrepj, irrepaj, vrtb, popb, 1) 
         ibi = isymoffso(irrepi, irrepbi, vrtb, popb, 1)
         if(irrepai/=1) iai = iai + ifvo(3)-ifvo(2)
         if(irrepbi/=1) ibi = ibi + ifvo(3)-ifvo(2)
         if(irrepaj/=1) iaj = iaj + ifvo(3)-ifvo(2)
         if(irrepbj/=1) ibj = ibj + ifvo(3)-ifvo(2)
         if(irrepj/=irrepi.and.irrepa/=irrepb) then
!$omp parallel do
            do j = 1, numj
            do i = 1, numi
            do b = 1, numb
            do a = 1, numa
               idx = iofft + ((j-1)*numi + i-1)*numab &
                          +  (b-1)*numa + a
               idxai = iai-1 + (i-1)*numa+a 
               idxbj = ibj-1 + (j-1)*numb+b
               idxaj = iaj-1 + (j-1)*numa+a
               idxbi = ibi-1 + (i-1)*numb+b
               t2(idx) = t2(idx) + &
                     fact*(icore(idxai)*icore(idxbj)-icore(idxbi)*icore(idxaj))
            enddo
            enddo
            enddo
            enddo
!$omp end parallel do
         elseif(irrepj==irrepi.and.irrepa/=irrepb) then
!$omp parallel do
            do j = 2, numj
            do i = 1, j-1
            do b = 1, numb
            do a = 1, numa
               idx = iofft + ((j-1)*(j-2)/2 + i-1)*numab &
                          +  (b-1)*numa + a
               idxai = iai-1 + (i-1)*numa+a 
               idxbj = ibj-1 + (j-1)*numb+b
               idxaj = iaj-1 + (j-1)*numa+a
               idxbi = ibi-1 + (i-1)*numb+b
               t2(idx) = t2(idx) + &
                     fact*(icore(idxai)*icore(idxbj)-icore(idxbi)*icore(idxaj))
            enddo
            enddo
            enddo
            enddo
!$omp end parallel do
         elseif(irrepj/=irrepi.and.irrepa==irrepb) then
!$omp parallel do
            do j = 1, numj
            do i = 1, numi
            do b = 2, numb
            do a = 1, b-1
               idx = iofft + ((j-1)*numi + i-1)*numab &
                          +  (b-1)*(b-2)/2 + a
               idxai = iai-1 + (i-1)*numa+a 
               idxbj = ibj-1 + (j-1)*numb+b
               idxaj = iaj-1 + (j-1)*numa+a
               idxbi = ibi-1 + (i-1)*numb+b
               t2(idx) = t2(idx) + &
                     fact*(icore(idxai)*icore(idxbj)-icore(idxbi)*icore(idxaj))
            enddo
            enddo
            enddo
            enddo
!$omp end parallel do
         elseif(irrepj==irrepi.and.irrepa==irrepb) then
!$omp parallel do
            do j = 2, numj
            do i = 1, j-1
            do b = 2, numb
            do a = 1, b-1
               idx = iofft + ((j-1)*(j-2)/2 + i-1)*numab &
                          +  (b-1)*(b-2)/2 + a
               idxai = iai-1 + (i-1)*numa+a 
               idxbj = ibj-1 + (j-1)*numb+b
               idxaj = iaj-1 + (j-1)*numa+a
               idxbi = ibi-1 + (i-1)*numb+b
               t2(idx) = t2(idx) + &
                     fact*(icore(idxai)*icore(idxbj)-icore(idxbi)*icore(idxaj))
            enddo
            enddo
            enddo
            enddo
!$omp end parallel do
         endif
      enddo
   enddo
enddo
!
!---------------for ABAB 
call zeroso(icore, nsize*2)
call myicopyso(t1, icore, ifvo(3)-ifvo(1))
iofft2(1) = 1
do irrepij = 1, nirrep - 1
   irrepab = dirprd(irrepij, 1)
   numij = irpdso(irrepij, popa, popb, 1)
   numab = irpdso(irrepab, vrta, vrtb, 1)
   iofft2(irrepij+1) = iofft2(irrepij) + numab*numij
enddo
!
do irrepij = 1, nirrep
   irrepab = dirprd(irrepij, 1)
   numab = irpdso(irrepab, vrta, vrtb, 1)
   numij = irpdso(irrepij, popa, popb, 1)
   do irrepj = 1, nirrep
      irrepi = dirprd(irrepij, irrepj)
      numi = popa(irrepi)
      numj = popb(irrepj)
      do irrepb = 1, nirrep
         irrepa = dirprd(irrepb, irrepab)
         numa = vrta(irrepa)
         numb = vrtb(irrepb)
         iofft = ioi3(2)-1 +iofft2(irrepij)-1 &
              + (isymoffso(irrepj,irrepij,popa,popb,1)-1)*numab &
              +  isymoffso(irrepb,irrepab,vrta,vrtb,1)-1
         irrepai = dirprd(irrepa, irrepi) 
         irrepbj = dirprd(irrepb, irrepj) 
         iai = isymoffso(irrepi, irrepai, vrta, popa, 1) 
         ibj = ifvo(2)-1 + isymoffso(irrepj, irrepbj, vrtb, popb, 1) 
         if(irrepai/=1) iai = iai + ifvo(3)-ifvo(1)
         if(irrepbi/=1) ibi = ibi + ifvo(3)-ifvo(1)
!$omp parallel do
            do j = 1, numj
            do i = 1, numi
            do b = 1, numb
            do a = 1, numa
               idx = iofft + ((j-1)*numi + i-1)*numab &
                          +  (b-1)*numa + a
               idxai = iai-1 + (i-1)*numa+a 
               idxbj = ibj-1 + (j-1)*numb+b
               t2(idx) = t2(idx) + &
                     fact*(icore(idxai)*icore(idxbj))
            enddo
            enddo
            enddo
            enddo
!$omp end parallel do
      enddo
   enddo
enddo


return
end
